home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok16 / memsystem / taskmemory.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  137 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    TaskMemory.mod
  4.     :Contents.   Allocation procedures using the Task.memEntry-list
  5.     :Author.     Nicolas Benezan [bne]
  6.     :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
  7.     :Phone.      711/333679
  8.     :Copyright.  Public Domain
  9.     :Language.   Modula-2
  10.     :Translator. M2Amiga AMSoft 3.2d
  11.     :History.    V1.0b [bne] 27.Jan.1989 (extracted from MemSystem1.1)
  12.     :History.    V1.1a [bne] 29.Mar.1989 (supports MemSystem1.3, Levels)
  13.     :Bugs.       does not handle Arts-levels perfectly if CLI-started
  14.     :Bugs.       (however, no serious malfunctions should occur)
  15.  
  16. **********************************************************************)
  17.  
  18. IMPLEMENTATION MODULE TaskMemory;
  19.  
  20. FROM SYSTEM     IMPORT ADR, ADDRESS, CAST;
  21. FROM Exec       IMPORT MemReqSet, MemReqs, TaskPtr, FindTask, NodePtr,
  22.                 AddHead, Remove, AllocEntry, FreeEntry, MemList, MemEntry,
  23.                 MemListPtr, Byte;
  24. FROM Arts       IMPORT TermProcedure, wbStarted, CurrentLevel;
  25.  
  26. CONST   ThisTask=NIL;
  27.         NodeName="TaskMemEntry";
  28.  
  29. TYPE    TaskMemEntry=RECORD
  30.           memList:MemList;
  31.           memEntry:MemEntry;
  32.         END;
  33.         TaskMemEntryPtr=POINTER TO TaskMemEntry;
  34.  
  35. PROCEDURE AllocTaskMem(byteSize:LONGINT;requirements:MemReqSet):ADDRESS;
  36. VAR     Task:TaskPtr;
  37.         Entry:TaskMemEntry;
  38.         EntryPtr:TaskMemEntryPtr;
  39.  
  40. BEGIN
  41.   WITH Entry DO
  42.     memList.numEntries:=1;
  43.     memEntry.reqs:=requirements;
  44.     memEntry.length:=byteSize;
  45.   END;
  46.   EntryPtr:=ADDRESS(AllocEntry(ADR(Entry)));
  47.   IF LONGINT(EntryPtr)<0 THEN
  48.     RETURN NIL;
  49.   ELSE
  50.     Task:=FindTask(ThisTask);
  51.     WITH EntryPtr^.memList.node DO
  52.       name:=ADR(NodeName);
  53.       pri:=CAST(Byte,Task^.memEntry.pad);
  54.     END;
  55.     AddHead(ADR(Task^.memEntry),ADDRESS(EntryPtr));
  56.     RETURN EntryPtr^.memEntry.addr;
  57.   END;
  58. END AllocTaskMem;
  59.  
  60. PROCEDURE DeallocTaskMem(VAR Pointer:ADDRESS);
  61. VAR     Task:TaskPtr;
  62.         EntryPtr:TaskMemEntryPtr;
  63. BEGIN
  64.   Task:=FindTask(ThisTask);
  65.   EntryPtr:=ADDRESS(Task^.memEntry.head);
  66.   LOOP
  67.     IF EntryPtr^.memList.node.succ#NIL THEN
  68.       IF EntryPtr^.memEntry.addr=Pointer THEN
  69.         (* this assumes that the MemEntry-list is not corrupt !!! *)
  70.         (* otherwise guru is likely to occur *)
  71.         Remove(ADDRESS(EntryPtr));
  72.         FreeEntry(ADDRESS(EntryPtr));
  73.         Pointer:=NIL;
  74.         EXIT
  75.       END;
  76.       EntryPtr:=ADDRESS(EntryPtr^.memList.node.succ);
  77.     ELSE
  78.       EXIT
  79.     END;
  80.   END;
  81. END DeallocTaskMem;
  82.  
  83. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  84. (* The following procedures are included to be compatible with Heap     *)
  85. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  86.  
  87. PROCEDURE AllocMem(VAR adr:ADDRESS;size:LONGINT;chipMem:BOOLEAN);
  88. BEGIN
  89.   IF chipMem THEN
  90.     adr:=AllocTaskMem(size,CHIP);
  91.   ELSE
  92.     adr:=AllocTaskMem(size,ANY);
  93.   END;
  94. END AllocMem;
  95.  
  96. PROCEDURE Allocate(VAR adr:ADDRESS;size:LONGINT);
  97. BEGIN
  98.   adr:=AllocTaskMem(size,ANY);
  99. END Allocate;
  100.  
  101. PROCEDURE Deallocate(VAR adr:ADDRESS);
  102. BEGIN
  103.   DeallocTaskMem(adr);(* tell me why m2cV3.11 can't alias *)
  104. END Deallocate;
  105.  
  106. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  107. (* Free the entries we added to the memEntry-list of a CLI              *)
  108. (* (because the CLI-Task is not RemTask()ed when we exit)               *)
  109. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  110. PROCEDURE CleanupCliHeap;
  111. VAR     Task:TaskPtr;
  112.         EntryPtr,NextEntryPtr:TaskMemEntryPtr;
  113. BEGIN
  114.   IF CurrentLevel()<=0 THEN
  115.     Task:=FindTask(ThisTask);
  116.     EntryPtr:=ADDRESS(Task^.memEntry.head);
  117.     LOOP
  118.       NextEntryPtr:=ADDRESS(EntryPtr^.memList.node.succ);
  119.       IF NextEntryPtr=NIL THEN
  120.         EXIT
  121.       END;
  122.       IF EntryPtr^.memList.node.name=ADR(NodeName) THEN
  123.         (* if it is ours *)
  124.         Remove(ADDRESS(EntryPtr));
  125.         FreeEntry(ADDRESS(EntryPtr));
  126.       END;
  127.       EntryPtr:=NextEntryPtr;
  128.     END;
  129.   END;
  130. END CleanupCliHeap;
  131.  
  132. BEGIN
  133.   IF NOT wbStarted THEN
  134.     TermProcedure(CleanupCliHeap);
  135.   END;
  136. END TaskMemory.
  137.